home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / libguile / vports.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-03  |  4.8 KB  |  239 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45.  
  46.  
  47.  
  48. /* {Ports - soft ports}
  49.  * 
  50.  */
  51.  
  52.  
  53. #ifdef __STDC__
  54. static int 
  55. prinsfpt (SCM exp, SCM port, int writing)
  56. #else
  57. static int 
  58. prinsfpt (exp, port, writing)
  59.      SCM exp;
  60.      SCM port;
  61.      int writing;
  62. #endif
  63. {
  64.   scm_prinport (exp, port, "soft");
  65.   return !0;
  66. }
  67.  
  68. /* sfputc sfwrite sfputs sfclose 
  69.  * are called within a SYSCALL.  
  70.  *
  71.  * So we need to set errno to 0 before returning.  sfflush
  72.  * may be called within a SYSCALL.  So we need to set errno to 0
  73.  * before returning.
  74.  */
  75.  
  76. #ifdef __STDC__
  77. static int 
  78. sfputc (int c, SCM p)
  79. #else
  80. static int 
  81. sfputc (c, p)
  82.      int c;
  83.      SCM p;
  84. #endif
  85. {
  86.   scm_apply (VELTS (p)[0], MAKICHR (c), listofnull);
  87.   errno = 0;
  88.   return c;
  89. }
  90.  
  91. #ifdef __STDC__
  92. static sizet 
  93. sfwrite (char *str, sizet siz, sizet num, SCM p)
  94. #else
  95. static sizet 
  96. sfwrite (str, siz, num, p)
  97.      char *str;
  98.      sizet siz;
  99.      sizet num;
  100.      SCM p;
  101. #endif
  102. {
  103.   SCM sstr;
  104.   sstr = scm_makfromstr (str, siz * num, 0);
  105.   scm_apply (VELTS (p)[1], sstr, listofnull);
  106.   errno = 0;
  107.   return num;
  108. }
  109.  
  110. #ifdef __STDC__
  111. static int 
  112. sfputs (char *s, SCM p)
  113. #else
  114. static int 
  115. sfputs (s, p)
  116.      char *s;
  117.      SCM p;
  118. #endif
  119. {
  120.   sfwrite (s, 1, strlen (s), p);
  121.   return 0;
  122. }
  123.  
  124. #ifdef __STDC__
  125. static int 
  126. sfflush (SCM stream)
  127. #else
  128. static int 
  129. sfflush (stream)
  130.      SCM stream;
  131. #endif
  132. {
  133.   SCM f = VELTS (stream)[2];
  134.   if (BOOL_F == f)
  135.     return 0;
  136.   f = scm_apply (f, EOL, EOL);
  137.   errno = 0;
  138.   return BOOL_F == f ? EOF : 0;
  139. }
  140.  
  141. #ifdef __STDC__
  142. static int 
  143. sfgetc (SCM p)
  144. #else
  145. static int 
  146. sfgetc (p)
  147.      SCM p;
  148. #endif
  149. {
  150.   SCM ans;
  151.   ans = scm_apply (VELTS (p)[3], EOL, EOL);
  152.   errno = 0;
  153.   if (FALSEP (ans) || EOF_VAL == ans)
  154.     return EOF;
  155.   ASSERT (ICHRP (ans), ans, ARG1, "getc");
  156.   return ICHR (ans);
  157. }
  158.  
  159. #ifdef __STDC__
  160. static int 
  161. sfclose (SCM p)
  162. #else
  163. static int 
  164. sfclose (p)
  165.      SCM p;
  166. #endif
  167. {
  168.   SCM f = VELTS (p)[4];
  169.   if (BOOL_F == f)
  170.     return 0;
  171.   f = scm_apply (f, EOL, EOL);
  172.   errno = 0;
  173.   return BOOL_F == f ? EOF : 0;
  174. }
  175.  
  176.  
  177.  
  178. PROC (s_make_soft_port, "make-soft-port", 2, 0, 0, scm_make_soft_port);
  179. #ifdef __STDC__
  180. SCM 
  181. scm_make_soft_port (SCM pv, SCM modes)
  182. #else
  183. SCM 
  184. scm_make_soft_port (pv, modes)
  185.      SCM pv;
  186.      SCM modes;
  187. #endif
  188. {
  189.   SCM z;
  190.   ASSERT (NIMP (pv) && VECTORP (pv) && 5 == LENGTH (pv), pv, ARG1, s_make_soft_port);
  191.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_make_soft_port);
  192.   NEWCELL (z);
  193.   DEFER_INTS;
  194.   CAR (z) = tc16_sfport | scm_mode_bits (CHARS (modes));
  195.   SETSTREAM (z, pv);
  196.   scm_add_to_port_table (z);
  197.   ALLOW_INTS;
  198.   return z;
  199. }
  200.  
  201. #ifdef __STDC__
  202. static int 
  203. noop0 (FILE *stream)
  204. #else
  205. static int 
  206. noop0 (stream)
  207.      FILE *stream;
  208. #endif
  209. {
  210.   return 0;
  211. }
  212.  
  213. scm_ptobfuns scm_sfptob =
  214. {
  215.   scm_markcdr,
  216.   noop0,
  217.   prinsfpt,
  218.   0,
  219.   sfputc,
  220.   sfputs,
  221.   sfwrite,
  222.   sfflush,
  223.   sfgetc,
  224.   sfclose
  225. };
  226.  
  227.  
  228. #ifdef __STDC__
  229. void
  230. scm_init_vports (void)
  231. #else
  232. void
  233. scm_init_vports ()
  234. #endif
  235. {
  236. #include "vports.x"
  237. }
  238.  
  239.